home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / MISCPAS.ARJ / STAYRES.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-23  |  42KB  |  982 lines
  1. {$C-}
  2. {-----------------------------------------------------------------------------}
  3. {                                                                             }
  4. {                                                                             }
  5. {                                                                             }
  6. {         "  S o r r y ,  D a v e,   I   C a n ' t   D o   T h a t .  "       }
  7. {                                                                             }
  8. {                                                                             }
  9. {                                                          Arthur C. Clark    }
  10. {                                                           " 2 0 0 1 "       }
  11. {-----------------------------------------------------------------------------}
  12.  
  13. {  A  Turbo  "stay-resident" program clobbers the Dos register stack.  It
  14.   jumps over the Turbo run-time initialization code that would set up the
  15.   program registers  and environment.   Secondly,  a  stay-resident  program
  16.   could not ordinarily issue file I/O since that would clobber Dos interrupt
  17.   registers.  Therefore,  the following code proposes an inline solution,
  18.   providing a Turbo entry  stack  for  "stay-resident"  programs  and allowing
  19.   those programs to issue Dos I/O and other interrupts.
  20.  
  21.    This Turbo stay-resident demo has been put together to perform both Dos I/O
  22.    and Bios interrupts. It has also been tested for re-entrancy and
  23.    recursiveness on an IBM PC with PCDos .
  24.  
  25.     Separate the include files, compile to a COM file and execute with the
  26.     Alt-F10 key. It will also free its memory and return to Dos with the
  27.     Ctrl-Home key at the "Press a key" prompt. (Illustrated in the Stayxit
  28.     file). Maximum free dynamic memory should be between A40-B00 since this
  29.     demo uses a recursive stack.
  30.  
  31.                                                  The Hunters Helper
  32.  
  33.                                                   L.Ferris
  34.                                                   4268 26th St
  35.                                                   San Francisco,Ca. 94131
  36.                                                   [ 70357,2716 ]      }
  37. {-----------------------------------------------------------------------------}
  38. {     This code has been tested/used on an IBM PC using PC-DOS 2.10           }
  39. {-----------------------------------------------------------------------------}
  40.  
  41.  
  42. { Authors: Lane H. Ferris (Stay Resident Code)
  43.            Neil J. Rubenking (Directory code and ideas)
  44.            Jim Everingham (The Window Manager/Editor)
  45.            Other Public Gurus on whose shoulders we stand.
  46.  
  47. { PURPOSE:  This code will serve as a template to create other "Stay  Resident"
  48.             programs  in  Turbo  Pascal(tm).   This  code  intercepts  Int  16,
  49.             displacing original Interrupt  16  Vector  to  User  Interrupt  68.
  50.             During  execution  of  other  programs,  it  can  be invoked by the
  51.             special key combination  specified  by  "Our_Char"  (in  this  case
  52.             <Alt>-F10.)
  53. }
  54.  
  55. Program Stay_Resident;
  56.  
  57.   { * * * * * * * CONSTANTS * * * * * * * * * * * * * * * * * * * * * * }
  58.   const
  59.     Our_Char        =  113; {this is the scan code for AltF10}
  60.     Ctrl_Home       = #119; {Control Home Scan Code          }
  61.     Quit_Key        = #119;
  62.     Ctrl_End        = #117; {Control End Scan Code           }
  63.     User_Int        = $68; {place to put new interrupt}
  64.     Kybrd_Int       = $16; {BIOS keyboard interrupt}
  65.  
  66.   { - - - - - - - T Y P E    D E C L A R A T I O N S - - - - - - - - - - - -  }
  67.   Type
  68.     Regtype     = record Ax,Bx,Cx,Dx,Bp,Si,Di,Ds,Es,Flags:integer  end;
  69.     HalfRegtype = record Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh:byte              end;
  70.     filename_type = string[64];
  71.  
  72.   { - - - - - - - T Y P E D   C O N S T A N T S - - - - - - - - - - - - - - -}
  73.   Const
  74.     {regs is defined as a typed constant in order to get it in the code segment}
  75.     Regs   : regtype = (Ax:0;Bx:0;Cx:0;Dx:0;Bp:0;Si:0;Di:0;Ds:0;Es:0;Flags:0);
  76.  
  77.       OurDseg: integer = 0;            {Our Data Segment Value             }
  78.       OurSseg: integer = 0;            {Our Stack Segment Value            }
  79.       DosSseg: integer = 0;            {Dos Stack Segment Value            }
  80.       Inuse  : Boolean = false;        {Recursion flag                     }
  81.  
  82.  { - - - - - - - V A R I A B L E S - - - - - - - - - - - - - - - - - - - - - -}
  83.     Var
  84.       SaveRegs                      : regtype;
  85.       HalfRegs                      : halfregtype absolute regs;
  86.       Terminate_flag                : boolean ;
  87.       Keychr                        : char ;
  88.       Old_Xpos,Old_Ypos             : integer ;
  89. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  90.  
  91. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  92. {  Check Terminate Keys
  93. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  94. Procedure Chk_Term_Key;
  95. {$I StayXit.Inc}                   {Check for Exit to Dos                     }
  96. {-----------------------------------------------------------------------------}
  97. {            G  E  T  F  I  L  E                                              }
  98. {-----------------------------------------------------------------------------}
  99.  
  100. procedure get_file;
  101. {$I staysubs.inc}
  102. var
  103.   attribyte,
  104.   OldAttribute : byte;
  105.   Xcursor      : integer ;
  106.   Ycursor      : integer ;
  107. {----------------------------------------------------------------------------}
  108. begin
  109.  
  110.       filename := '*.*' ;
  111.       attribyte := 255 ;
  112.       OldAttribute := attribyte;
  113.  
  114.               Xcursor := 2 ;
  115.               Ycursor := 1 ;
  116.               GotoXy(Xcursor,Ycursor) ;
  117.  
  118.           Find_First(attribyte,filename,Retcode);
  119.               If Retcode = 0 then
  120.                  begin
  121.                  write(Filename);
  122.                  Ycursor := Ycursor +1 ;
  123.                  end;
  124.           {Now we repeat Find_Next until an error occurs }
  125.  
  126.               repeat
  127.                 Find_Next(attribyte,filename,Retcode);
  128.                 if Retcode = 0 then
  129.                  begin
  130.                         GotoXY(Xcursor,Ycursor);
  131.                         Write(filename) ;
  132.                         Ycursor := Ycursor + 1 ;
  133.  
  134.                         if WhereY >= 14 then
  135.                         begin
  136.                         Xcursor := Xcursor + 16 ;
  137.                         Ycursor := 1 ;
  138.                         end;
  139.  
  140.                         if (Xcursor >= 50) and (Ycursor = 13 ) then
  141.                         begin
  142.                         Ycursor := Ycursor + 1;
  143.                         GotoXY(Xcursor,Ycursor);
  144.                         Write ('More...');
  145.                         read ;
  146.                         clrscr ;
  147.                         Xcursor := 2 ;
  148.                         Ycursor := 1 ;
  149.                         end;
  150.                  end;
  151.                until Retcode <> 0;
  152.  
  153.                GotoXY(Xcursor,Ycursor); Write('Press a key . . .');
  154.                repeat until keypressed ;
  155.                Chk_Term_Key ;          { See if Return to Dos }
  156. end;
  157.  
  158. {-----------------------------------------------------------------------------}
  159. {        D   E  M  O                                                          }
  160. {-----------------------------------------------------------------------------}
  161. Procedure Demo ;                   { Give Demonstration of Code               }
  162.  
  163. {$I WINDMNGR.INC}
  164.  
  165. begin
  166.  
  167.      Add_Window(5,5,75,20,11,0,2);
  168.  
  169.      Get_file;
  170.  
  171.      Remove(1);
  172.  
  173. end; { Demo }
  174.  
  175.  
  176. {----------------------------------------------------------------------------}
  177. {              P R O C E S S   I N T E R R U P T                             }
  178. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  179. Procedure Process_Intr;
  180.  
  181. {  PURPOSE:  This  procedure  replaces  the  standard  keyboard  interrupt.  If
  182.             anything but <Alt>-F10 is pressed,  the key is  passed  on  to  the
  183.             standard  keyboard  interrupt.  B*U*T  when  <Alt>- F10 is pressed,
  184.             this program takes over.  The variable InUse  is  set  to  TRUE  to
  185.             ensure that this code doesn't try to run "on top of itself " AND to
  186.             indicate  to the Inline code to save/restore the original interrupt
  187.             regs.
  188. }
  189.  
  190. Begin
  191.           { K e y b o a r d    Interrupt   o c c u r s   here }
  192. {----------------------------------------------------------------------}
  193. {$I Staysave.inc}
  194. {----------------------------------------------------------------------}
  195. { Check the Int 16 request function in Ah reg:
  196.                    0 = read character from Keyboard
  197.                    1 = check character available
  198.                    2 = check shift key values
  199. }
  200. if HalfRegs.Ah <> 0 then  {if this is not character request...}
  201.    Begin
  202.    Intr(User_Int,Regs)    { just pass it on to standard interrupt }
  203.    End
  204.  
  205. Else      { HalfRegs.Ah = 0 then    { This is a Character Request }
  206.   Begin   {Get Keyboard Char }
  207.  
  208.   Intr (User_Int, Regs);             { Use the standard interrupt}
  209.  
  210.   if (Halfregs.Ah = Our_Char)        { Separate the test so code }
  211.                                      { performs efficiently      }
  212.      then if  (not InUse) then
  213.  
  214.      begin { Demo }
  215.      InUse := true;                  { "dont clobber saved stack"}
  216. {            .
  217.              .
  218.              .  Your
  219.              .      Program
  220.              .             Goes
  221.              .                 Here
  222.              .
  223. }                                    { Get current Cursor Position    }
  224.      Old_Xpos := WhereX; Old_Ypos := WhereY;
  225.      Demo ;
  226.      GotoXY(Old_Xpos,Old_Ypos);       { Put Cursor Back                }
  227.      Regs.Ax := Ord(KeyChr) shl 8 ;        {Give back Last entered char     }
  228.      InUse := false;                  { ok to restore interrupted stack }
  229.      end  { Demo }
  230.  
  231.   end; {Get Keyboard Char }
  232.  
  233. {$I Stayrstr.inc}                      { Return to Caller }
  234. end ;
  235. {-----------------------------------------------------------------------}
  236.  
  237. {The main program installs the new interrupt routine and makes it permanently
  238.  resident as the keyboard interrupt.  The old keyboard interrupt is addressed
  239.  through #68H, so it can still be used.
  240.  
  241. The following dos calls are used:
  242.  
  243.  Function 25 - Install interrupt address
  244.                input al = int number,
  245.                ds:dx = address to install
  246.  
  247.  Function 35 - get interrupt address
  248.                input al = int number
  249.                output es:bx = address in interrupt
  250.  
  251.  Function 31 - terminate and stay resident
  252.                input dx = size of resident program obtained from the memory
  253.                allocation block at [Cs:0 - $10 + 3]
  254.  
  255.  Function 49 - Free Allocated Memory
  256.                input Es = Block Segment to free
  257.  
  258.  Interrupt 20 - Return to invoking process
  259. }
  260.  
  261. {-----------M A I N    B L O C K---------------------------------------------}
  262. Begin                                  {**main**}
  263.  
  264.   InUse  := false;
  265.   OurDseg:= Dseg;       { Save the Data Segment Address for Interrupts }
  266.   OurSseg:= Sseg;       { Save our Stack Segment for Interrupts        }
  267.  
  268.   Terminate_Flag := false ;
  269.  
  270.   {now install the interrupt routine}
  271.  
  272.   SaveRegs.Ax := $35 shl 8 + User_Int;
  273.   Intr($21,SaveRegs);                 {Check to make sure int not already used}
  274.  
  275.   if SaveRegs.Es <> $00 then
  276.     WriteLn ('Interrupt in use -- can''t install Resident Turbo Code')
  277.   else
  278.     begin
  279.  
  280.       { Initialize Your Progam Here since you wont get control again
  281.         until "Our_Char" is entered from the Keyboard.               }
  282.  
  283.       SaveRegs.Ax := $35 shl 8 + Kybrd_Int;
  284.       Intr($21,SaveRegs);        {get the address of keyboard interrupt }
  285.  
  286.       SaveRegs.Ax := $25 shl 8 + User_Int;
  287.       SaveRegs.Ds := SaveRegs.Es;
  288.       SaveRegs.Dx := SaveRegs.Bx;
  289.       Intr($21,SaveRegs);         { set the user-interrupt address to point
  290.                                 { to the keyboard interrupt address }
  291.  
  292.       SaveRegs.Ax := $25 shl 8 + Kybrd_Int;
  293.       SaveRegs.Ds := Cseg;
  294.       SaveRegs.Dx := Ofs(Process_Intr);
  295.       Intr ($21,SaveRegs);        { set the keyboard interrupt to point to
  296.                                   "Process-Intr" above}
  297.  
  298.       Writeln('  Turbo Stay-Resident Demo: Press Alt-F10');
  299.  
  300.       {now terminate and stay resident}
  301.                                               { Pass return code of zero    }
  302.       SaveRegs.Ax := $31 shl 8 + 0 ;          { Terminate and Stay Resident }
  303.       SaveRegs.Dx := MemW [Cseg-1:0003] ;     { Prog_Size from Allocation Blk}
  304.       Intr ($21,SaveRegs);
  305.  
  306.     end;
  307.        { END OF RESIDENCY CODE }
  308. end.
  309. {****************************************************************************}
  310. {                 S  T  A  Y  S  A  V  E  .  I  N  C                         }
  311. {                                                                            }
  312. {           This is the Staysave.Inc file included above                     }
  313. {                                                                            }
  314. {      Separate the code out into a file or replace the $I Staysave.Inc      }
  315. {                statement above with this code.                             }
  316. {****************************************************************************}
  317.  
  318. {This Inline routine will save the regs and Stack for Stay resident programs.
  319.  It restores Ds and Ss from the previously saved integer constants "OurDseg"
  320.   and "OurSSeg". This is important since Dos is not re-entrant and any attempt
  321.   to use Interrupt I/O services will clobber the very stack on which the
  322.   Resident Turbo program just saved its regs. Thus, on the final return, you
  323.   and Toto will end up somewhere other than Kansas and without your Ruby Reds.
  324.    }
  325.  
  326. { Arthor:      L.H. Ferris
  327.  
  328.        Distributed to the Public Domain for use without profit.
  329.                     Original Version 5.15.85
  330. }
  331.                                    { On entry the Stack will already contain: }
  332.                                    {  1) Sp for Dos                           }
  333.                                    {  2) Bp for Dos                           }
  334.                                    {  3) Ip for Dos                           }
  335.                                    {  4) Cs for Dos                           }
  336.   Inline (                         {  5) Flags for Dos                        }
  337.  
  338.  
  339.  
  340.     $FA /                              {  Cli       Stop all interrupts       }
  341.  
  342.                                        { Bp and Sp aready saved at Begin Stmt }
  343.     $55/                               {Push   Bp  Save again for Regpak      }
  344.     $BD/Regs/                          {Mov    Bp,offset REGS}
  345.     $2E/$89/$46/$00/                   {CS:Mov [Bp+0],AX}
  346.     $2E/$89/$5E/$02/                   {Cs:Mov [Bp+2],Bx}
  347.     $2E/$89/$4E/$04/                   {CS:Mov [Bp+4],CX}
  348.     $2E/$89/$56/$06/                   {CS:Mov [Bp+6],DX}
  349.     $2E/$8F/$46/$08/                   {Pop    Cs:[Bp+8] Fetch Bp from stack  }
  350.     $2E/$89/$76/$0A/                   {CS:Mov [Bp+A],SI}
  351.     $2E/$89/$7E/$0C/                   {CS:Mov [Bp+C],DI}
  352.     $2E/$8C/$5E/$0E/                   {CS:Mov [Bp+E],DS}
  353.     $2E/$8C/$46/$10/                   {CS:Mov [Bp+10],ES}
  354.     $9C/                               {PUSHF  put Flags on stack to retrieve }
  355.     $2E/$8F/$46/$12/                   {POP Cs:[Bp+12]}
  356.  
  357.     { If Current SS := [OurSseg] or Inuse = True, then dont save the stack. }
  358.     { This program is being recursive.                                      }
  359.  
  360.      $2E/$80/$3E/Inuse/$01/   {Cmp  Cs:[Inuse],1                          }
  361.      $74/$4D/                 {Je   ReCurin ------J-U-M-P---------------  }
  362.  
  363.     { Now save 5 Words from the Dos Stack before performing any         }
  364.     { I/O or re-using the Dos stack                                     }
  365.  
  366.      $2E/$8C/$16/DosSSeg/     {Mov  Cs:DosSSeg,SS Save Dos Stack Segment    }
  367.      $8C/$D6/                 {Mov  Si,SS         If this is our Stack Seg  }
  368.      $8E/$C6/                 {Mov  Es,Si         Get Dos StackSeg          }
  369.      $2E/$8E/$16/OurSSeg/     {Mov  SS,Cs:OurSSeg Get our Stack segment     }
  370.      $2E/$8E/$1E/OurDseg/     {Mov  Ds,Cs:Our_Ds  Setup our Data Segment    }
  371.  
  372.  
  373.      $2E/$3B/$36/OurSSeg/     {Cmp  Si,Cs:OurSSeg ..use current Stack ptr   }
  374.      $89/$E6/                 {Mov  Si,Sp         ..value..else reset stack }
  375.      $74/$05/                 {Je   $+5           ..to original Turbo stack }
  376.      $3E/$8B/$36/$74/$01/     {Mov  Si,Ds:[174]   ..(cf. code at B2B 3.0x)  }
  377.  
  378.      $87/$F4/                 {Xchg Sp,Si         Set new  Stack Pointer    }
  379.  
  380.      $2E/$FF/$76/$00/         {Push [Bp+0]  Save Dos/User regs for Exit     }
  381.      $2E/$FF/$76/$02/         {Push [Bp+2]  Save Bx                         }
  382.      $2E/$FF/$76/$04/         {Push [Bp+4]  Save Cx                         }
  383.      $2E/$FF/$76/$06/         {Push [Bp+6]  Save Dx                         }
  384.                               {Push [Bp+8]  Save Bp                         }
  385.      $2E/$FF/$76/$0A/         {Push [Bp+A]  Save Si                         }
  386.      $2E/$FF/$76/$0C/         {Push [Bp+C]  Save Di                         }
  387.      $2E/$FF/$76/$0E/         {Push [Bp+E]  Save Ds                         }
  388.      $2E/$FF/$76/$10/         {Push [Bp+10] Save Es                         }
  389.  
  390.  
  391.      $2E/$8E/$16/OurSSeg/     {Mov  SS,Cs:OurSSeg Set up our Stack          }
  392.      $56/                     {Push Si            Save bottom of Dos Stack  }
  393.      $2E/$8C/$5E/$0E/         {Mov  Cs:[Bp+E],Ds  Set New Data Segmt in regs}
  394. {Recurin                                            Jump here if Recursion  }
  395.      $FB                      {Sti Enable Interrupts                        }
  396.  
  397.        ) ;
  398. {****************************************************************************}
  399. {                  S  T  A  Y  R  S  T  R  .  I  N  C                        }
  400. {                                                                            }
  401. {           This is the StayRstr.Inc file included above                     }
  402. {       Separate the code out into a file or replace the $I StayRstr.Inc     }
  403. {                  statement above with this code.                           }
  404. {****************************************************************************}
  405.  
  406. { Inline Code to restore the stack and regs moved to the Turbo Resident
  407.   Program Stack to allow re-entrancy into the Dos Code for I/O and
  408.   recursion from built-in Turbo functions.
  409.  
  410. ; Arthor:      L.H. Ferris
  411.  
  412. ; Distributed to the Public Domain for use without profit.
  413. ; Original Version 5.15.85
  414.  
  415. ;----------------------------------------------------------------------;
  416. ;        Restore the Dos Regs and Stack
  417. ;----------------------------------------------------------------------;
  418.  
  419. ; On entry the Stack will already contain:
  420. ;
  421. ;        1) Bottom of Dos Stack Ptr
  422. ;        2) Dos Flags
  423. ;        3) Dos Code Segment
  424. ;        4) Dos Instruction Ptr
  425. ;        5) Dos Base Pointer
  426. ;        6) Dos Original Stack Ptr
  427. }
  428.     inline(
  429.  
  430.     $BD/Regs/                          {Mov    Bp,offset REGS}
  431.     $2E/$8B/$46/$00/                   {CS:Mov Ax,[Bp+0]}
  432.     $2E/$8B/$5E/$02/                   {Cs:Mov Bx,[Bp+2]}
  433.     $2E/$8B/$4E/$04/                   {CS:Mov Cx,[Bp+4]}
  434.     $2E/$8B/$56/$06/                   {CS:Mov Dx,[Bp+6]}
  435.  
  436.     $2E/$8B/$76/$0A/                   {CS:Mov Si,[Bp+A]}
  437.     $2E/$8B/$7E/$0C/                   {CS:Mov Di,[Bp+C]}
  438.     $2E/$8E/$5E/$0E/                   {CS:Mov DS,[Bp+E]}
  439.     $2E/$8E/$46/$10/                   {CS:Mov ES,[Bp+10]}
  440.     $2E/$FF/$76/$12/                   {Push Cs:[Bp+12]}
  441.     $9D/                               {Popf}
  442.  
  443.     { If [Cs:InUse]:= True,  then dont restore the stack. This program is   }
  444.     { being recursive. Else restore  Dos Stack and Program Entry registers  }
  445.  
  446.      $2E/$80/$3E/Inuse/$01/   {Cmp  byte ptr Cs:[Inuse],1                   }
  447.      $74/$12/                 {Je   ReCurOut                                }
  448.  
  449.       $FA /                   { Cli      ; Stop all interrupts    }
  450.  
  451.  
  452.     $5D/                     {Pop Bp           Save Dos Sp across pops   }
  453.  
  454.     $07/                     {Pop  Es                                     }
  455.     $1F/                     {Pop  Ds                                     }
  456.     $5F/                     {Pop  Di                                     }
  457.     $5E/                     {Pop  Si                                     }
  458.     $5A/                     {Pop  Dx                                     }
  459.     $59/                     {Pop  Cx                                     }
  460.     $5B/                     {Pop  Bx                                     }
  461.     $44/$44/                 {Inc sp/Inc sp Thow old Ax value away        }
  462.  
  463.     $89/$EC/                  {Mov  Sp,Bp         Setup Dos Stack Ptr      }
  464.     $2E/$8E/$16/DosSSeg/      {Mov  SS,Cs:DosSSeg Give back Dos Stack      }
  465.  
  466. {RecurOut                              Clean up the Stack              }
  467.  
  468.     $5D/                               {Pop Bp  Throw away old dos Sp  }
  469.  
  470.     $BD/Regs/                          {Mov    Bp,offset REGS}
  471.     $2E/$FF/$76/$12/                   {Push Cs:[Bp+12]}
  472.     $9D/                               {Popf}
  473.     $5D/                               {Pop Bp  Retrieve old BP        }
  474.  
  475.     $FB/                               {Sti     Enable interrupts      }
  476.     $CA/$02/$00                        {Ret Far 002                    }
  477.         );
  478.  
  479. {****************************************************************************}
  480. {                         S T A Y S U B S  .  I N C                          }
  481. {                                                                            }
  482. {   Separate this file into "Staysubs.Inc" to provide Directory routines     }
  483. {       for the Stay-Resident Demo.                                          }
  484. {                                                                            }
  485. {****************************************************************************}
  486.  
  487.  
  488. {----------------------------------------------------------------------------}
  489. {                  F I L E         S U B R O U T I N E S                     }
  490. {----------------------------------------------------------------------------}
  491.   type
  492.     Dir_Entry   = record
  493.                       Reserved : array[1..21] of byte;
  494.                       Attribute: byte;
  495.                       Time, Date, FileSizeLo, FileSizeHi : integer;
  496.                       Name : string[13];
  497.                     end;
  498.   var
  499.     RetCode     : byte;
  500.     Filename  : filename_type;
  501.     Buffer    : Dir_Entry;
  502.     Attribute : byte;
  503. {----------------------------------------------------------------------------}
  504. {                S  E  T       Disk  Transfer  Address                       }
  505. {----------------------------------------------------------------------------}
  506. Procedure Disk_Trns_Addr(var Disk_Buf);
  507. var
  508.   Registers : regtype;
  509. Begin
  510.   with Registers do
  511.     begin
  512.       Ax := $1A shl 8;                 { Set disk transfer address to  }
  513.       Ds := seg(Disk_Buf);             { our disk buffer               }
  514.       Dx := ofs(Disk_Buf);
  515.       msdos(Registers);
  516.     end;
  517. end;
  518. {----------------------------------------------------------------------------}
  519. {                  F I N D   N E X T   F I L E   E N T R Y                   }
  520. {----------------------------------------------------------------------------}
  521. Procedure Find_Next(var Att:byte; var Filename : Filename_type;
  522.                                       var Next_RetCode : byte);
  523. var
  524.   Registers  : regtype;
  525.   Carry_flag : integer;
  526.   N          : byte;
  527.  
  528. Begin  {Find_Next}
  529.   Buffer.Name := '             ';     { Clear result buffer }
  530.   with Registers do
  531.       begin
  532.       Ax := $4F shl 8;                 { Dos Find next function }
  533.       MsDos(Registers);
  534.       Att := Buffer.Attribute;         { Set file attribute     }
  535.       Carry_flag := 1 and Flags;       { Isolate the Error flag }
  536.       Filename := '             ';
  537.       if Carry_flag = 1 then
  538.         Next_RetCode := Ax and $00FF
  539.       else
  540.         begin                          { Move file name         }
  541.         Next_RetCode := 0;
  542.         for N := 0 to 12 do FileName[N+1] := Buffer.Name[N];
  543.         end;
  544.     end;  {with}
  545. end;
  546. {----------------------------------------------------------------------------}
  547. {              F I N D   F I R S T   F I L E   F U N C T I O N               }
  548. {----------------------------------------------------------------------------}
  549. Procedure Find_First (var Att: byte;
  550.                       var Filename: Filename_type;
  551.                       var RetCode_code : byte);
  552.  
  553.   var
  554.       Registers        :regtype;
  555.       Carry_flag       :integer;
  556.       Mask, N          :byte;
  557.  
  558.   begin
  559.     Disk_Trns_Addr(buffer);
  560.     Filename[length(Filename) + 1] := chr(0);
  561.     Buffer.Name := '             ';
  562.     with Registers do
  563.       begin
  564.       Ax := $4E shl 8;                  { Dos Find First Function }
  565.       Cx := Att;                        { Attribute of file to fine }
  566.       Ds := seg(Filename);              { Ds:Dx Asciiz string to find }
  567.       Dx := ofs(Filename) + 1;
  568.       MsDos(Registers);
  569.       Att := Buffer.Attribute;          { set the file attribute byte  }
  570.  
  571.         { If error occured set, Return code. }
  572.  
  573.         Carry_flag := 1 and Flags;      { If Carry flag, error occured }
  574.                                         { and Ax will contain Return code }
  575.         if Carry_flag = 1 then
  576.           begin
  577.           RetCode_code := Ax and $00FF;
  578.           end
  579.  
  580.         else
  581.           begin
  582.           RetCode_code := 0;
  583.           Filename := '             ';
  584.           for N := 0 to 12 do FileName[N+1] := Buffer.Name[N];
  585.           end;
  586.  
  587.       end;  {with}
  588. end;
  589. {****************************************************************************}
  590. {                       S T A Y X I T   .   I N C                            }
  591. {                                                                            }
  592. {     Separate this file into "StayXIT.Inc" to provide a "Go-non-Resident"   }
  593. {                   routine or the Stay-Resident Demo.                       }
  594. {                                                                            }
  595. {****************************************************************************}
  596.  
  597. {-----------------------------------------------------------------------------}
  598. {  Stay_Xit Check Terminate Keys                                              }
  599. {                                                                             }
  600. {  Check for Ctrl_Home key. Free the Environment , the program segment        }
  601. {  memory and return to Dos. Programs using this routine ,must be the         }
  602. {  last program in memory, else ,a hole will be left causing Dos              }
  603. {  to go GooGoo .                                                             }
  604. {-----------------------------------------------------------------------------}
  605.  
  606.    Begin { Block }
  607.       if Keypressed then
  608.          Begin { Keypressed }
  609.          While Keypressed do read (Kbd,Keychr);
  610.          If Keychr = Quit_Key then
  611.             Begin { Terminate }
  612.             Writeln ('Stay-Resident program Terminating') ;
  613.             SaveRegs.Ax := $35 shl 8 + User_Int;
  614.             MsDos(SaveRegs);           {get the original Int 16 Addr   }
  615.  
  616.             SaveRegs.Ax := $25 shl 8 + Kybrd_Int;
  617.             SaveRegs.Ds := SaveRegs.Es;
  618.             SaveRegs.Dx := SaveRegs.Bx; { set the user-interrupt address to }
  619.             MsDos(SaveRegs);            { the keyboard interrupt address    }
  620.  
  621.             MemW[$00:User_Int * 4] := 0 ; { Clear User Interrupt vector     }
  622.             MemW[$00:User_Int * 4 + 2] :=0;
  623.  
  624.             Saveregs.Ax := $49 shl 8 + 0 ;    { Free Allocated Block function}
  625.             Saveregs.Es := MemW[Cseg:$2C] ; { Free environment block       }
  626.             MsDos( Saveregs ) ;
  627.  
  628.             Saveregs.Ax := $49 shl 8 + 0 ;    { Free Allocated Block function}
  629.             Saveregs.Es := Cseg ;             { Free Program                 }
  630.             MsDos( Saveregs ) ;
  631.  
  632.             Intr($20,Regs) ;           { Return to Dos }
  633.  
  634.             End   { Terminate } ;
  635.          End  { Keypressed };
  636.    End  { Block };
  637. {****************************************************************************}
  638. {                       W I N D M N G R    .   I N C                         }
  639. {                                                                            }
  640. {     Separate this file into "WindMngr.Inc" to provide a Window for         }
  641. {                    the Stay-Resident Demo.                                 }
  642. {                                                                            }
  643. {****************************************************************************}
  644.             { Window Manager/Editor System Include file .. }
  645. { Author:
  646.           
  647.            Jim Everingham (The Window Manager/Editor)                        }
  648.           
  649.  
  650. Const
  651.       MaxScreens = 8;     { Number of Windows Allowed, do not Change }
  652.       Screen_seg = $B800; { Change to #B000 for MonoChrome, Change
  653.                             then # sign to a Dollar sign Though. }
  654.       Data_Addr = $0000;
  655.       Fc        : Array[1..4, 1..7] of Integer
  656.                 = ((218, 196, 191, 179, 192, 196, 217),
  657.                    (201, 205, 187, 186, 200, 205, 188),
  658.                    (213, 205, 184, 179, 212, 205, 190),
  659.                    (219, 219, 219, 219, 219, 219, 219));
  660.  
  661. type maxstr     = string[80];
  662.      window_rec = record
  663.                         x1,x2,y1,y2,c1,b1,w1,w2: Integer;
  664.                         Screen: Array[1..4000] of byte;
  665.                   end;
  666.  
  667. var  Stack_Top,Last_Window_Num,
  668.      line_pos,F1         : Integer;
  669.      screen              : Array[1..4000] of byte;
  670.      real_screen         : Array[1..4000] of byte absolute Screen_Seg:Data_Addr;
  671.      Page_1              : Array[1..4000] of byte absolute Screen_Seg:$1000;
  672.      Imig                : Array [1..MaxScreens] of Window_rec;
  673.      Original            : Array[1..4000] of byte;
  674.      Coords              : Array[1..8,1..MaxScreens] of Integer;
  675.  
  676.  
  677. {----------------------------------------------------------------------------}
  678. {                              S E T _ P A G E                               }
  679. {----------------------------------------------------------------------------}
  680. procedure set_page(page: byte);
  681.  
  682. type
  683.   Result =
  684.     record
  685.       AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: byte;
  686.     end;
  687. var rec:result;
  688.  
  689. begin
  690.   Rec.AX := page;
  691.   Rec.BX := $05;
  692.   Intr($10,Rec);
  693. end;
  694.  
  695. {----------------------------------------------------------------------------}
  696. {                        S  C  R  N  _  O  F  F                              }
  697. {----------------------------------------------------------------------------}
  698. Procedure Scrn_off;
  699. begin
  700.      inline($52/$50/$ba/$d8/$03/$b0/$21/$ee/$58/$5a)
  701. end;
  702. {----------------------------------------------------------------------------}
  703. {                        S  C  R  N  _  O  N                                 }
  704. {----------------------------------------------------------------------------}
  705. Procedure Scrn_on;
  706. begin
  707.      inline($52/$50/$ba/$d8/$03/$b0/$29/$ee/$58/$5a)
  708. end;
  709. {----------------------------------------------------------------------------}
  710. {                        A  C  T  I  V  E                                    }
  711. {----------------------------------------------------------------------------}
  712. Function active: integer;
  713. begin
  714.      active:=stack_top
  715. end;
  716. {----------------------------------------------------------------------------}
  717. {                              P  U  S  H                                    }
  718. {----------------------------------------------------------------------------}
  719. Procedure Push(Ulx, Uly, Lrx, Lry, Foreground, Background: integer);
  720.  
  721. { This procedure Saves screens in memory. When a new window is put
  722.   on the Screen, the preceding window is stored away for later reference.}
  723.  
  724. begin
  725.      { If last Window up, move the Original Screen into Screen Memory}
  726.      if stack_top = 0 then
  727.            begin
  728.               Scrn_off;
  729.               move(real_screen, Original, 4000);
  730.               Scrn_on
  731.            end;
  732.      {Save all Data concerning the windows}
  733.      if (Stack_top < MaxScreens) and (Stack_Top >= 0) then
  734.             begin
  735.                  Stack_top:=Stack_top+1;
  736.                  Imig[Stack_top].x1:=Ulx;
  737.                  Imig[Stack_top].y1:=Uly;
  738.                  Imig[Stack_top].x2:=Lrx;
  739.                  Imig[Stack_top].y2:=Lry;
  740.                  Imig[stack_top].c1:=Foreground;
  741.                  Imig[Stack_top].b1:=Background
  742.             end;
  743.  
  744.      { Push Screen on Stack ... Sort of... }
  745.      Scrn_off;
  746.      Move(real_screen,Imig[Stack_top].Screen,4000);
  747.      Scrn_on
  748. end;
  749. {----------------------------------------------------------------------------}
  750. {                              P  O  P                                       }
  751. {----------------------------------------------------------------------------}
  752. Procedure Pop;
  753.  
  754. { This Procedure takes the screen that procedes the current window and
  755.   Copies back to screen memory, restores all data concerning the previous
  756.   window and activates it.. Neat huh? }
  757.  
  758. begin
  759.  
  760.      { If no windows are active, save the current screen }
  761.      if stack_top =0 then
  762.            begin
  763.                 normvideo;
  764.                 window(1,1,80,25);
  765.                 Scrn_off;
  766.                 move(Original, real_screen, 4000);
  767.                 Scrn_on;
  768.            end;
  769.  
  770.      { Get Preceding screen and copy it to screen memory }
  771.      Scrn_off;
  772.      Move(Imig[Stack_top].Screen,Real_Screen,4000);
  773.      Scrn_on;
  774.      Stack_top:=Stack_top-1
  775. end;
  776. {----------------------------------------------------------------------------}
  777. {                           W  R  I  T  E  X  Y                              }
  778. {----------------------------------------------------------------------------}
  779. Procedure Writexy(long_string:maxstr; xcoord,ycoord:integer; var color: integer);
  780.  
  781. { This procedure Draws whatever you want, wherever you want, by changing the
  782.   value of Screen in the variable declaration, it can draw a "Picture" any-
  783.   were in memory. This allows for the Speed of the window making process..}
  784.  
  785. var str_len, real_pos, scr_pos: integer;
  786.  
  787. begin
  788. {$I-}
  789.      str_len:=length(long_string); { So I know how much to write }
  790.      Scr_pos:=0;
  791.  
  792.      { The next 8 lines write the string in every "even" location in memory
  793.        and ever odd location gets the attribute with determines how the
  794.        string is displayed on the screen}
  795.      for real_pos:=1 to str_len do
  796.                  if scr_pos < 4001 then
  797.                        begin
  798.                             scr_pos:=((xcoord*2)-1)+(ycoord*160);
  799.                             screen[scr_pos]:=ord(copy(long_string,real_pos,1));
  800.                             screen[scr_pos+1]:=color;
  801.                             xcoord:=xcoord+1;
  802.                        end
  803. {$I+}
  804. end;
  805.  
  806. {----------------------------------------------------------------------------}
  807. {                              F  R  A  M  E                                 }
  808. {----------------------------------------------------------------------------}
  809. Procedure Frame(WindowType, UpperLeftX, UpperLeftY, LowerRightX, LowerRightY, color: Integer);
  810.  
  811. { This procedure draws the window frame in another part of memory. }
  812. var i: integer;
  813. begin
  814.      WriteXY(chr(Fc[WindowType,1]),UpperLeftX, UpperLeftY,color);
  815.      for i:=UpperLeftX+1 to LowerRightX-1 do WriteXY(chr(Fc[WindowType,2]),i,UpperleftY,color);
  816.      WriteXY(chr(Fc[WindowType,3]),i+1,UpperleftY,color);
  817.      for i:=UpperLeftY+1 to LowerRightY-1 do
  818.          begin
  819.               WriteXY(chr(Fc[WindowType,4]),UpperLeftX , i,color);
  820.               WriteXY(chr(Fc[WindowType,4]),LowerRightX, i,color);
  821.          end;
  822.      WriteXY(chr(Fc[WindowType,5]),UpperLeftX, LowerRightY, color);
  823.      for i:=UpperLeftX+1 to LowerRightX-1 do WriteXY(chr(Fc[WindowType,6]),i,LowerrightY,color);
  824.      WriteXY(chr(Fc[WindowType,7]),i+1,LowerRightY,color);
  825. end  { Frame };
  826. {----------------------------------------------------------------------------}
  827. {                         I  N  I  T  I  A  L  I  Z  E                       }
  828. {----------------------------------------------------------------------------}
  829. Procedure initialize;
  830.  
  831. { Set up memory and the stack }
  832.  
  833. var i:integer;
  834.  
  835. begin
  836.      Stack_top:=0;
  837.      move(real_screen,screen,4000);
  838.      with imig[1] do for i:=1 to 4000 do screen[i]:=$00;
  839.      for i:=2 to 9 do move(Imig[i-1].screen,imig[i].screen,4000);
  840.      move(imig[1].screen,screen,4000);
  841.      move(imig[1].screen,original,4000)
  842. end;
  843. {----------------------------------------------------------------------------}
  844. {                    A  D  D  _  W  I  N  D  O  W                            }
  845. {----------------------------------------------------------------------------}
  846. Procedure Add_window(UpperLeftX,UpperLeftY,LowerRightX,LowerRightY,Foreground,
  847.                  BackGround, WindowType: Integer);
  848.  
  849. { This procedure does all the laborous work for you.. The variables make it
  850.   Fairly easy to understand. }
  851.  
  852. Var i,j,k,Color: Integer;
  853.  
  854. begin
  855.      Imig[Stack_top].w1:=whereX;
  856.      Imig[Stack_top].w2:=WhereY;
  857.      UpperLeftX:=UpperLeftX+1;
  858.      LowerRightX:=LowerRightX-1;
  859.      LowerRightY:=LowerRightY-2;
  860.      f1:=WindowType;color:=0;
  861.      Scrn_off;
  862.      move(real_screen,screen,4000);
  863.      Scrn_on;
  864.  
  865.      { Set color attribute for direct writeng to memory }
  866.      if background < 17 then Color:=foreground+(background*16);
  867.  
  868.      { Check for invalid window frame types }
  869.      if (WindowType > 5) or (WindowType < 0) then
  870.               begin
  871.                    Clrscr;
  872.                    Writeln('Invalid Frame Type!')
  873.               end
  874.     else
  875.  
  876.      { If the window is valid then Procede }
  877.               begin
  878.  
  879.      { Fill color Attribute of window directly into memory }
  880.                    k:=1;
  881.                    for j:=UpperLeftY to LowerRightY do
  882.                            for i:=UpperLeftX to LowerRightX do
  883.                                     begin
  884.                                          k:=(j*160)+(i*2);
  885.                                          Screen[k]:=Color;
  886.                                          Screen[k-1]:=$20
  887.                                     end;
  888.  
  889.     { Frame Window }
  890.                    Case Windowtype of
  891.                              1:Frame(WindowType,UpperLeftX-1,UpperLeftY-1,
  892.                                       LowerRightX+1,LowerRightY+1,
  893.                                       color);
  894.                              2:Frame(WindowType,UpperLeftX-1,UpperLeftY-1,
  895.                                       LowerRightX+1,LowerRightY+1,
  896.                                       color);
  897.                              3:Frame(WindowType,UpperLeftX-1,UpperLeftY-1,
  898.                                            LowerRightX+1,LowerRightY+1,
  899.                                            color);
  900.                              4:Frame(WindowType,UpperLeftX-1,UpperLeftY-1,
  901.                                       LowerRightX+1,LowerRightY+1,
  902.                                       color);
  903.                              end { Case }
  904.               end;
  905.  
  906.     { Activate newly formed window }
  907.     Window(1,1,80,25);
  908.     Window(UpperLeftX,UpperLeftY+1,LowerRightX,LowerRightY+1);
  909.     push(UpperLeftx,UpperLeftY+1,LowerRightX,LowerRightY+1,Foreground, Background);
  910.     Scrn_off;
  911.     Move(screen,real_screen,4000);gotoxy(1,1);
  912.     Scrn_on;
  913.     Textcolor(Foreground);TextBackground(backGround);ClrScr;
  914. end;
  915. {----------------------------------------------------------------------------}
  916. {                    C  O  L  O  R  _  W  I  N  D  O  W                      }
  917. {----------------------------------------------------------------------------}
  918. Procedure Color_window(Foreground, Background: integer);
  919.  
  920. { This procedure allows you to change the foreground and background color
  921.   of the active window. }
  922.  
  923. var i,j,Color: Integer;
  924.  
  925. begin
  926.  
  927.      { Set Attribute value }
  928.      if background < 8 then Color:=foreground+(background*16);
  929.  
  930.      { Write new attribute direclty to screen memory }
  931.      for j:=(Imig[Stack_top].y1-2) to Imig[Stack_top].y2 do
  932.             for i:=(Imig[Stack_top].x1-1) to (Imig[Stack_top].x2+1) do
  933.                     begin
  934.                          Real_Screen[(j*160)+(i*2)]:=Color
  935.                     end
  936. end;
  937. {----------------------------------------------------------------------------}
  938. {                        R  E  M  O  V  E                                    }
  939. {----------------------------------------------------------------------------}
  940. Procedure Remove(Num_to_Remove: Integer);
  941.  
  942. { This Procedure removes 1 or a specified number of windows from the
  943.   screen and reactivates the underlying window }
  944.  
  945. var i: integer;
  946. begin
  947.      if (Num_to_Remove > 0) and (Num_to_Remove < MaxScreens) then
  948.           for i:=1 to Num_to_remove do Pop
  949.      else
  950.          Pop;
  951.      Window(1,1,80,25);
  952.      Window(Imig[Stack_top].x1+1,Imig[Stack_top].y1,Imig[Stack_top].x2,Imig[Stack_top].y2);
  953.      gotoxy(1,1);
  954.      TextBackground(Imig[Stack_top].b1);TextColor(Imig[Stack_top].c1);
  955.      GotoXY((Imig[Stack_top].w1-1),Imig[Stack_top].w2)
  956. end;
  957. {----------------------------------------------------------------------------}
  958. {                   W  I  N  D  O  W  _  T  I  T  L  E                       }
  959. {----------------------------------------------------------------------------}
  960. Procedure Window_Title(Name: Maxstr; color:integer);
  961.  
  962. var i, k, l, m: integer;
  963.  
  964. begin
  965.      If Length(name)>0 then
  966.      begin
  967.      l:=1;
  968.      color:=color+(Imig[Stack_top].b1*16);
  969.      if f1 < 4 then Real_Screen[(((Imig[Stack_top].Y1-2)*160)+(Imig[Stack_top].X1*2))+l]:=$5b;
  970.      for i:=1 to length(Name) do
  971.              begin
  972.                   k:=(((Imig[Stack_top].Y1-2)*160)+(Imig[Stack_top].X1*2))+l+1;
  973.                   Real_Screen[k+1]:=ord(copy(Name,i,1));
  974.                   Real_Screen[k+2]:=color;
  975.                   l:=l+2
  976.              end;
  977.      if f1 < 4 then Real_Screen[k+3]:=$5d
  978.      end
  979. end;
  980.  
  981. { Thats all.. }
  982.